perm filename TESTP.SAI[PIX,HPM]1 blob sn#463416 filedate 1979-08-09 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN "TESTP"
C00009 ENDMK
C⊗;
BEGIN "TESTP"
comment enormous halftones;
REQUIRE "PIXHDR.SAI[VIS,HPM]" SOURCE_FILE;
INTEGER ARRAY PC,PO[0:10];
INTEGER I,J,K,L,M,PL,LN,CH,OCH; STRING S;
INTEGER PYLO,PXLO,PYHI,PXHI;

PRINT("Output picture dimensions (height, width):"); S←INCHWL;
I←INTSCAN(S,K); J←INTSCAN(S,K);
MAKDIM(I,J,12,PC[0]);
MAKDIM(I,J+36,1,PO[0]);
PRINT("Ouput picture name:");
OCH←CREPFL(PO[0],INCHWL);

PYLO←0; PYHI←PO[PCLN]-1; PXLO←36; PXHI←PO[LNBY]-1;
  
  BEGIN
  DEFINE GRIDSIZ=4;
  REAL BM;
  LABEL BPTDL,ERRSZ,ERRSP,ERRSM,ERRSL,BPTSL,GRT,ERAJ,TRASH;
  INTEGER ARRAY SCNLIN[-1:PC[LNWD]-1],BPTS,BPTD[0:PXHI-PXLO+1];
  INTEGER ARRAY OUTLIN[0:PO[LNWD]-1];
  REAL ARRAY ERRS[-1:PXHI-PXLO+2],THRES[0:GRIDSIZ-1,0:PXHI-PXLO+1];

  J←POINT(PC[BYBI],SCNLIN[-1],35);
  FOR I←0 STEP 1 UNTIL PC[LNBY]-1 DO IDPB(K←(PC[BMAX]*(I/(PC[LNBY]-1))),J);

  FOR I←0 STEP 1 UNTIL GRIDSIZ%2-1 DO 
  FOR J←0 STEP 1 UNTIL PXHI-PXLO+1 DO
   BEGIN INTEGER JJ;
   JJ←J MOD GRIDSIZ; IF JJ≥GRIDSIZ%2 THEN JJ←GRIDSIZ-1-JJ;
   THRES[GRIDSIZ-I-1,J]←THRES[I,J]←
   ((JJ-GRIDSIZ/4+.5)*(I-GRIDSIZ/4+.5)/(GRIDSIZ/4-.5)↑2)*.05+.5;
   END;

  FOR J←PXLO STEP 1 UNTIL PXHI DO
    BEGIN
    L←J-PXLO;
    K←(PC[LNBY]-1)*L/(PXHI-PXLO);
    BPTS[L]←POINT(PC[BYBI],SCNLIN[K%PC[WDBY]],((K MOD PC[WDBY])+1)*PC[BYBI]-1);
    BPTD[L]←POINT(1,OUTLIN[J%36],J MOD 36);
    END;
  BM←1/PC[BMAX];
     
  I←LOCATION(BPTD[0]); START_CODE MOVE 0,I; HRRM 0,BPTDL; END;
  I←LOCATION(BPTS[0]); START_CODE MOVE 0,I; HRRM 0,BPTSL; END;
  I←LOCATION(ERRS[0]); START_CODE MOVE 0,I; HRRM 0,ERRSL; HRRM 0,ERRSZ;
	 ADDI 0,1; HRRM 0,ERRSP; SUBI 0,2; HRRM 0,ERRSM; END;

  FOR I←PYLO STEP 1 UNTIL PYHI DO
    BEGIN "YLOOP"  DEFINE T=1, ER=3, J=2;  INTEGER JJ;

    ARRCLR(OUTLIN);
    JJ←LOCATION(THRES[I MOD GRIDSIZ,0]);
       START_CODE MOVE 0,JJ; HRRM 0,TRASH; END;

    JJ←(-ABS(PXHI-PXLO)-1) LSH 18;
      START_CODE "XLOOP"
      MOVEI T,1; MOVE J,JJ;
BPTSL: LDB ER,(J); FLTR ER,ER; FMPR ER,BM;
ERRSL: FADR ER,(J);
TRASH: CAML ER,(J); JRST GRT;
BPTDL: DPB T,(J); JRST ERAJ;
GRT:   FSBRI ER,'201400; comment 1.0;
ERAJ:  FDVRI ER,'202600; comment 3.0;
ERRSM: FADRM ER,(J);
ERRSZ: MOVEM ER,(J);
ERRSP: FADRM ER,(J);
      AOBJN J,BPTSL;
      END "XLOOP";
    ARRYOUT(OCH,OUTLIN[0],PO[LNWD]);
    END "YLOOP";
  RELEASE(CH);
  RELEASE(OCH);
  END;

END "TESTP";